Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/BEZIER.CLS

Text File | 1996-05-04 | 11KB | 380 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjBezier"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private MaxU As Integer     ' Dimensions of control grid.
Private MaxV As Integer
Private Points() As Point3D ' Control points.

' grid holds a refined grid to display the surface.
Private grid As ObjPicture

' u and v increment parameters.
Private GapU As Single
Private GapV As Single
Private Du As Single
Private Dv As Single

' Display flags.
Private ShowControls As Boolean ' Draw control points?
Private ShowGrid As Boolean     ' Draw control grid?

Function Factorial(ByVal n As Single) As Single
Dim i As Integer
Dim tot As Single

    tot = 1
    For i = 2 To n
        tot = tot * i
    Next i
    Factorial = tot
End Function

' ************************************************
' Create the refined grid to display the surface.
' ************************************************
Public Sub InitializeGrid(gap_x As Single, gap_z As Single, d_x As Single, d_z As Single)
Dim u As Single
Dim v As Single
Dim x As Single
Dim y As Single
Dim z As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim pline As ObjPolyline

    GapU = gap_x
    GapV = gap_z
    Du = d_x
    Dv = d_z

    Set grid = New ObjPicture

    ' Create curves with constant u.
    For u = 0 To 1 + GapU / 10 Step GapU
        Set pline = New ObjPolyline
        grid.objects.Add pline

        SurfaceValue u, 0, x1, y1, z1

        For v = Dv To 1 + Dv / 10 Step Dv
            SurfaceValue u, v, x, y, z
            pline.AddSegment x1, y1, z1, x, y, z
            x1 = x
            y1 = y
            z1 = z
        Next v
    Next u

    ' Create curves with constant v.
    For v = 0 To 1 + GapV / 10 Step GapV
        Set pline = New ObjPolyline
        grid.objects.Add pline

        SurfaceValue 0, v, x1, y1, z1
        For u = Du To 1 + Du / 10 Step Du
            SurfaceValue u, v, x, y, z
            pline.AddSegment x1, y1, z1, x, y, z
            x1 = x
            y1 = y
            z1 = z
        Next u
    Next v
End Sub
' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer
Dim j As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.ApplyFull M

    ' Apply the matrix to the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub
' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer
Dim j As Integer

    ' Distort the grid if it exists.
    If Not grid Is Nothing Then grid.Distort D

    ' Distort the sparse data.
    For i = 0 To MaxU
        For j = 0 To MaxV
            D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
        Next j
    Next i
End Sub
' ************************************************
' Draw the transformed object on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim i As Integer
Dim j As Integer

    ' Draw the grid if it exists.
    If Not grid Is Nothing Then grid.Draw canvas, r

    ' Draw the control points if desired.
    If ShowControls Then
        On Error Resume Next
        For i = 0 To MaxU
            For j = 0 To MaxV
                canvas.Line (Points(i, j).trans(1) - 2, Points(i, j).trans(2) - 2)-Step(4, 4), , BF
            Next j
        Next i
    End If

    ' Draw the control grid if desired.
    If ShowGrid Then
        On Error Resume Next
        For i = 0 To MaxU
            canvas.CurrentX = Points(i, 0).trans(1)
            canvas.CurrentY = Points(i, 0).trans(2)
            For j = 1 To MaxV
                canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
            Next j
        Next i
        For j = 0 To MaxV
            canvas.CurrentX = Points(0, j).trans(1)
            canvas.CurrentY = Points(0, j).trans(2)
            For i = 1 To MaxU
                canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
            Next i
        Next j
    End If
End Sub

' ************************************************
' Read a Bezier surface from a file using Input.
' Assume the "BEZIER" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Get the basic information.
    Input #filenum, MaxU, MaxV, GapU, GapV, Du, Dv

    ' Allocate the Data array.
    SetBounds MaxU + 1, MaxV + 1

    ' Read the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            Input #filenum, _
                Points(i, j).coord(1), _
                Points(i, j).coord(2), _
                Points(i, j).coord(3)
            Points(i, j).coord(4) = 1
        Next j
    Next i

    ' Initialize the grid data.
    If Du = 0 Then
        Set grid = Nothing
    Else
        InitializeGrid GapU, GapV, Du, Dv
    End If
End Sub




' ************************************************
' Write a Bezier surface to a file using Write.
' Begin with "BEZIER" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Write basic information.
    Write #filenum, "BEZIER", _
        MaxU, MaxV, GapU, GapV, Du, Dv

    ' Write the data.
    For i = 0 To MaxU
        For j = 0 To MaxV
            Write #filenum, _
                Points(i, j).coord(1), _
                Points(i, j).coord(2), _
                Points(i, j).coord(3)
        Next j
    Next i
End Sub
' ************************************************
' Write the Bezier curve's grid object to a file
' using Write. The data can later be loaded into
' an ObjPicture object but not an ObjBezier
' object.
' ************************************************
Public Sub FileWriteGrid(filenum As Integer)
    If Not grid Is Nothing Then grid.FileWrite filenum
End Sub

' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Fix the grid points if the grid exists.
    If Not grid Is Nothing Then grid.FixPoints

    ' Fix the controls points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            For k = 1 To 3
                Points(i, j).coord(k) = _
                    Points(i, j).trans(k)
            Next k
        Next j
    Next i
End Sub


' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "BEZIER"
End Property
' ************************************************
' Let the user know if we are drawing the control
' grid.
' ************************************************
Property Get DrawGrid() As Boolean
    DrawGrid = ShowGrid
End Property

' ************************************************
' Let the user know if we are drawing the control
' points.
' ************************************************
Property Get DrawControls() As Boolean
    DrawControls = ShowControls
End Property


' ************************************************
' Let the user decide whether we should draw the
' control grid.
' ************************************************
Property Let DrawGrid(value As Boolean)
    ShowGrid = value
End Property
' ************************************************
' Let the user decide whether we should draw the
' control points.
' ************************************************
Property Let DrawControls(value As Boolean)
    ShowControls = value
End Property




' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer
Dim j As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.Apply M

    ' Apply the matrix to the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            m3Apply Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub





' ************************************************
' Set MaxU and MaxV ans allocate room for the
' control points.
' ************************************************
Public Sub SetBounds(NumX As Integer, NumZ As Integer)
    MaxU = NumX - 1
    MaxV = NumZ - 1
    ReDim Points(0 To NumX, 0 To NumZ)
End Sub

' ************************************************
' Set the value for a control point.
' ************************************************
Public Sub SetControlPoint(i As Integer, j As Integer, x As Single, y As Single, z As Single)
    Points(i - 1, j - 1).coord(1) = x
    Points(i - 1, j - 1).coord(2) = y
    Points(i - 1, j - 1).coord(3) = z
    Points(i - 1, j - 1).coord(4) = 1
End Sub
' ************************************************
' Return the value of the Bezier surface at this
' position.
' ************************************************
Private Sub SurfaceValue(u As Single, v As Single, x As Single, y As Single, z As Single)
Dim p As Integer
Dim i As Integer
Dim j As Integer
Dim pt As Point3D
Dim Bix As Single
Dim Bjz As Single

    For i = 0 To MaxU
        ' Compute Bix.
        Bix = Factorial(MaxU) / Factorial(i) / _
            Factorial(MaxU - i) * _
            u ^ i * (1 - u) ^ (MaxU - i)

        For j = 0 To MaxV
            ' Compute Bjz.
            Bjz = Factorial(MaxV) / Factorial(j) / _
                Factorial(MaxV - j) * _
                v ^ j * (1 - v) ^ (MaxV - j)

            ' Add to the coordinates.
            For p = 1 To 3
                pt.coord(p) = pt.coord(p) + _
                    Points(i, j).coord(p) * _
                    Bix * Bjz
            Next p
        Next j
    Next i

    ' Prepare the output.
    x = pt.coord(1)
    y = pt.coord(2)
    z = pt.coord(3)
End Sub